perm filename BLOCK2.XGP[F83,JMC] blob sn#732491 filedate 1983-11-17 generic text, type T, neo UTF8
/LMAR=0/XLINE=3/FONT#0=BAXL30/FONT#1=BAXM30/FONT#2=BASB30/FONT#3=SUB/FONT#4=SUP/FONT#5=BASL35/FONT#6=NGR25/FONT#7=MATH30/FONT#8=FIX25/FONT#9=GRKB30
␈↓ α∧␈↓␈↓ u1


␈↓ α∧␈↓α␈↓ ε\CS206

␈↓ α∧␈↓α␈↓ βpImproving a Program for Building Structures out of blocks

␈↓ α∧␈↓␈↓ αTWe␈αdescribe␈αa␈αprogram␈αfor␈αtransforming␈αone␈α
structure␈αmade␈αof␈αpiles␈αof␈αblocks␈αinto␈α
another.
␈↓ α∧␈↓This␈α⊂program␈α⊂is␈α⊂suboptimal␈α⊂in␈α∂a␈α⊂certain␈α⊂way,␈α⊂and␈α⊂the␈α∂problem␈α⊂is␈α⊂to␈α⊂fix␈α⊂this␈α⊂deficiency.␈α∂ We
␈↓ α∧␈↓represent␈α
a␈α
structure␈α
as␈α
a␈α
list␈α
of␈α
towers␈α
and␈α
a␈α
tower␈α
as␈α
a␈α
list␈α
of␈α
blocks.␈α
 Thus␈α
the␈α
expression␈α((A␈α
B)
␈↓ α∧␈↓(C))␈αrepresents␈αa␈αstructure␈αin␈αwhich␈αblock␈αA␈αis␈αon␈αblock␈αB␈αwhich␈αis␈αon␈αthe␈αtable,␈αand␈αblock␈α
C␈αis
␈↓ α∧␈↓on␈αthe␈α
table␈αby␈α
itself.␈α The␈αmove␈α
of␈αputting␈α
block␈αA␈α
onto␈αblock␈αC␈α
is␈αrepresented␈α
by␈α(A␈α
C).␈α We
␈↓ α∧␈↓require␈αthat␈αa␈αblock␈αand␈αits␈αdestination␈αbe␈αclear␈αbefore␈αa␈αmove␈αcan␈αbe␈αmade.␈α Putting␈αblock␈αA␈αon
␈↓ α∧␈↓the␈αtable␈αwill␈αbe␈αrepresented␈αby␈α(A␈αTABLE).␈α We␈αassume␈αthat␈αthe␈αtable␈αcan␈αhold␈αas␈αmany␈αblocks
␈↓ α∧␈↓as we want.

␈↓ α∧␈↓␈↓ αTThe␈α∂program␈α∞represents␈α∂a␈α∞situation␈α∂by␈α∞a␈α∂pair␈α∞consisting␈α∂of␈α∞the␈α∂structure␈α∞existing␈α∂in␈α∞that
␈↓ α∧␈↓situation␈α
and␈α
a␈αlist␈α
of␈α
the␈α
moves␈αleading␈α
to␈α
it.␈α For␈α
example,␈α
the␈α
situation␈αafter␈α
the␈α
structure␈α((A␈α
B
␈↓ α∧␈↓C))␈α⊃has␈α⊃been␈α⊂built␈α⊃from␈α⊃the␈α⊂above␈α⊃initial␈α⊃configuration␈α⊂will␈α⊃be␈α⊃(((A␈α⊂B␈α⊃C))␈α⊃(A␈α⊂B)␈α⊃(B␈α⊃C)␈α⊂(A
␈↓ α∧␈↓TABLE))␈αif␈αthe␈αblocks␈αhave␈αbeen␈αmoved␈αoptimally,␈αand␈αthe␈αinitial␈αsituation␈αitself␈αis␈α(((A␈αB)␈α(C))),
␈↓ α∧␈↓which is the same as the pair (((A B) (C)).NIL).

␈↓ α∧␈↓␈↓ αTThe␈α∀main␈α∀function␈α∀is␈α∃(BUILD␈α∀STRUCTURE␈α∀S)␈α∀where␈α∀the␈α∃variable␈α∀STRUCTURE
␈↓ α∧␈↓represents␈α∪the␈α∪structure␈α∪to␈α∪be␈α∩built␈α∪and␈α∪S␈α∪is␈α∪the␈α∩current␈α∪situation.␈α∪ The␈α∪value␈α∪of␈α∩(BUILD
␈↓ α∧␈↓STRUCTURE␈αS)␈α
is␈αthe␈α
final␈αsituation.␈α
 Thus␈α(BUILD␈α
'((A␈αB␈α
C))␈α'(((A␈α
B)␈α(C))))␈α
=>␈α(((A␈α
B␈αC))␈α
(A
␈↓ α∧␈↓B)␈α⊃(B␈α⊃C)␈α⊃(A␈α⊃TABLE)).␈α⊃ BUILD␈α⊃calls␈α∩BUILD1␈α⊃for␈α⊃each␈α⊃tower␈α⊃in␈α⊃the␈α⊃desired␈α∩structure␈α⊃and
␈↓ α∧␈↓BUILD1␈α
builds␈αthe␈α
towers.␈α
 It␈αdoes␈α
so␈αby␈α
using␈α
MOVE␈αto␈α
move␈αeach␈α
block␈α
from␈αwhere␈α
it␈α
is␈αto
␈↓ α∧␈↓the␈αfinal␈αposition,␈αbuilding␈αthe␈αtower␈αbottom␈αup.␈α MOVE␈αhas␈αto␈αclear␈αthe␈αblock␈αto␈αbe␈αmoved␈αand
␈↓ α∧␈↓the␈α
block␈αonto␈α
which␈α
it␈αis␈α
to␈α
be␈αput␈α
which␈α
it␈αdoes␈α
by␈α
calling␈αCLEAR.␈α
 CLEAR␈α
puts␈αany␈α
necessary
␈↓ α∧␈↓blocks␈α∀on␈α∀the␈α∀table.␈α∀ The␈α∀computation␈α∀of␈α∀new␈α∀situations␈α∀is␈α∀actually␈α∀done␈α∀by␈α∃the␈α∀function
␈↓ α∧␈↓UPDATE.

␈↓ α∧␈↓␈↓ αTThere␈α∪are␈α∪a␈α∪few␈α∪more␈α∀auxiliary␈α∪functions␈α∪which␈α∪you␈α∪shouldn't␈α∪have␈α∀much␈α∪difficulty
␈↓ α∧␈↓understanding.

␈↓ α∧␈↓␈↓ αTNow␈α∂for␈α∞the␈α∂desired␈α∂improvement.␈α∞ When␈α∂a␈α∞block␈α∂is␈α∂cleared,␈α∞the␈α∂blocks␈α∞that␈α∂have␈α∂to␈α∞be
␈↓ α∧␈↓moved␈α∂are␈α∂put␈α∂on␈α∞the␈α∂table.␈α∂ Sometimes␈α∂however,␈α∞a␈α∂block␈α∂could␈α∂be␈α∞moved␈α∂directly␈α∂to␈α∂its␈α∞final
␈↓ α∧␈↓position.␈α The␈αproblem␈αis␈αto␈αmodify␈αBUILD␈αand␈αits␈αauxiliary␈αfunctions␈αto␈αattain␈αthis␈α
goal.␈α Note
␈↓ α∧␈↓that␈αthis␈αstill␈αwon't␈αalways␈αgive␈αa␈αminimal␈αsequence␈αof␈αmoves.␈α Other␈αthan␈αsearching␈αthe␈αspace␈αof
␈↓ α∧␈↓sequences of moves, I don't know an algorithm for finding a minimal sequence.

␈↓ α∧␈↓␈↓ αTMaking the requested improvement is not absolutely trivial.

␈↓ α∧␈↓(defun␈αbuild␈α
(structure␈αs)␈α(if␈α
(null␈αstructure)␈αs␈α
(build␈α(cdr␈αstructure)␈α
(build1␈α(reverse␈α(car␈α
structure))
␈↓ α∧␈↓'table s))))

␈↓ α∧␈↓(defun␈α∞build1␈α∞(rtower␈α∂location␈α∞s)␈α∞(if␈α∞(null␈α∂rtower)␈α∞s␈α∞(build1␈α∞(cdr␈α∂rtower)␈α∞(car␈α∞rtower)␈α∂(move␈α∞(car
␈↓ α∧␈↓rtower) location s))))

␈↓ α∧␈↓(defun␈αmove␈α(block␈αlocation␈αs)␈α(if␈α(on␈αblock␈αlocation␈α(car␈αs))␈αs␈α(immove␈αblock␈αlocation␈α(clear␈αblock
␈↓ α∧␈↓(clear location s)))))
␈↓ α∧␈↓␈↓ u2


␈↓ α∧␈↓(defun␈α∩immove␈α∪(block␈α∩location␈α∪s)␈α∩(cons␈α∪(update␈α∩(car␈α∩s)␈α∪(list␈α∩block␈α∪location))␈α∩(cons␈α∪(list␈α∩block
␈↓ α∧␈↓location) (cdr s))))

␈↓ α∧␈↓(defun clear (block s) (if (or (null block) (eq block 'table)) s (clear1 block (find block (car s)) s)))

␈↓ α∧␈↓(defun update1 (s1 pair) (cond

␈↓ α∧␈↓␈↓ αT((or (null s1) (and (null (car pair)) (null (cadr pair)))) s1)

␈↓ α∧␈↓␈↓ αT((eq (caar s1) (car pair)) (cons (cdar s1) (update1 (cdr s1) pair)))

␈↓ α∧␈↓␈↓ αT((eq␈α∂(caar␈α∂s1)␈α∞(cadr␈α∂pair))␈α∂(cons␈α∞(cons␈α∂(car␈α∂pair)␈α∞(car␈α∂s1))␈α∂(update1␈α∞(cdr␈α∂s1)␈α∂(list␈α∂(car␈α∞pair)
␈↓ α∧␈↓nil))))

␈↓ α∧␈↓␈↓ αT(t (cons (car s1) (update1 (cdr s1) pair)))))

␈↓ α∧␈↓␈↓ αT(defun␈αupdate␈α(s1␈αpair)␈α(update2␈α(if␈α(eq␈α(cadr␈αpair)␈α'table)␈α(cons␈α(list␈α(car␈αpair))␈α(update1␈αs1
␈↓ α∧␈↓(cons (car pair) nil))) (update1 s1 pair))))

␈↓ α∧␈↓␈↓ αT(defun␈α
update2␈α
(s1)␈α
(cond␈α
((null␈α
s1)␈α
nil)␈α
((null␈α(car␈α
s1))␈α
(cdr␈α
s1))␈α
(t␈α
(cons␈α
(car␈α
s1)␈α(update2␈α
(cdr
␈↓ α∧␈↓s1))))))

␈↓ α∧␈↓␈↓ αT(defun find (b s1) (if (member b (car s1)) (car s1) (find b (cdr s1))))

␈↓ α∧␈↓␈↓ αT(defun␈α
clear1␈α
(b␈α
tower␈α∞s)␈α
(if␈α
(eq␈α
b␈α∞(car␈α
tower))␈α
s␈α
(clear1␈α∞b␈α
(cdr␈α
tower)␈α
(immove␈α∞(car␈α
tower)
␈↓ α∧␈↓'table s))))

␈↓ α∧␈↓␈↓ αT(defun␈αon␈α
(a␈αb␈αs1)␈α
(on1␈αa␈αb␈α
(find␈αa␈αs1)))␈α
(defun␈αon1␈α(a␈α
b␈αtower)␈α(and␈α
(not␈α(null␈α
tower))␈α(or
␈↓ α∧␈↓(and␈α∞(eq␈α∞(car␈α
tower)␈α∞a)␈α∞(or␈α
(and␈α∞(eq␈α∞b␈α
'table)␈α∞(null␈α∞(cdr␈α
tower)))␈α∞(and␈α∞(not␈α
(null␈α∞(cdr␈α∞tower)))␈α
(eq
␈↓ α∧␈↓(cadr tower) b)))) (on1 a b (cdr tower)))))

␈↓ α∧␈↓␈↓ αT;;;␈α
tests␈α
(setq␈α
st1␈α
'((a␈α
b)␈α
(c)))␈α
(setq␈α
st2␈α
'((a␈αb␈α
c)))␈α
(setq␈α
s0␈α
(cons␈α
t1␈α
nil))␈α
(setq␈α
tt0␈α
'(b␈α
c))␈α(immove␈α
'a
␈↓ α∧␈↓'c␈αs0)␈α
(move␈α'a␈α
'c␈αs0)␈α
(immove␈α'a␈α'table␈α
s0)␈α(build1␈α
'(c)␈α'a␈α
s0)␈α(build1␈α'(c␈α
b)␈α'table␈α
s0)␈α(build␈α
st2␈αs0)
␈↓ α∧␈↓(setq␈αst3␈α
'((a␈αb␈α
c)␈α(d␈α
e)␈α(f)))␈α
(setq␈αst4␈α
'((a␈αb␈α
c␈αd␈α
f)␈α(e)))␈α
(build␈αst4␈α
(cons␈αst3␈α
nil))␈α(setq␈α
st5␈α'((c␈α
b)␈α(a␈αd␈α
e)
␈↓ α∧␈↓(f))) (build st5 (cons st3 nil))